home *** CD-ROM | disk | FTP | other *** search
/ Oh!X 2001 Spring / Oh!X 2001 Spring Special CD-ROM (Japan).7z / Oh!X 2001 Spring Special CD-ROM (Japan) (Track 1).bin / TCLTK / BLOCKUP / blockup.tcl < prev    next >
Text File  |  2000-05-07  |  17KB  |  696 lines
  1. #
  2. # BLOCKUP.tcl : ゲーム「ブロックアップ」
  3. #
  4. #               Copyright (C) 2000 by Makoto Hiroi
  5. #
  6. # 駒を下から押し上げて、同じ色を３つ以上ならべて消すゲーム
  7. # 色は、赤、青、黄、緑、紫、水色、オレンジ
  8. #
  9. # 大域変数
  10. # board()      : 積みあがった駒の色
  11. # board_l()    : ブロックの移動ライン
  12. # color()      : 色
  13. # block()      : ブロックの色
  14. # next_block() : 次のブロック
  15. # block_x      : ブロックの先頭 x 座標
  16. # remove_piece : 消去できる駒の座標（リスト）
  17. # down_piece   : 駒が落ちた場所の座標（リスト）
  18. # move_count   : ブロックを移動させるカウンタ
  19. # play_flag    : 0 : ゲーム終了, 1 : ゲーム中
  20. # piece_num    : 駒の種類（ゲーム中で使用する）
  21. # clolr_num    : メニューで設定する
  22. # name,data,score : トップ１０用スコア
  23. #
  24.  
  25. # ヘルプファイルの表示
  26. proc help {} {
  27.     global path_name
  28.     if {![winfo exist .t0]} {
  29.         toplevel .t0
  30.         wm title .t0 "BlockUp Help"
  31.         text .t0.text -yscrollcommand ".t0.scroll set"
  32.         scrollbar .t0.scroll -command ".t0.text yview"
  33.     pack .t0.scroll -side right -fill y
  34.     pack .t0.text -side left
  35.     # ファイルの読み込み
  36.         set f [open "$path_name/BLOCKUP.TXT" r]
  37.     while {![eof $f]} {
  38.         .t0.text insert end [read $f 1000]
  39.     }
  40.     close $f
  41.     .t0.text configure -state disabled
  42.     }
  43. }
  44.  
  45. # スコアファイルリード
  46. proc read_score_file {} {
  47.     global score_file name date score
  48.     set now_date [clock seconds]
  49.     if [file exists $score_file] {
  50.     # ファイルの読み込み
  51.     set f [open $score_file r]
  52.     foreach j {6 7 8} {
  53.         for {set i 1} {$i <= 10} {incr i} {
  54.         if {[gets $f line] < 0} {
  55.             # ダミーデータをセット
  56.             set l " \t$now_data\t0"
  57.         }
  58.         set l [split $line "\t"]
  59.         set name($j,$i)  [lindex $l 0]
  60.         set date($j,$i)  [lindex $l 1]
  61.         set score($j,$i) [lindex $l 2]
  62.         }
  63.     }
  64.     close $f
  65.     } else {
  66.     # ダミーデータのセット
  67.     foreach j {6 7 8} {
  68.         for {set i 1} {$i <= 10} {incr i} {
  69.         set name($j,$i) ""
  70.         set date($j,$i) $now_date
  71.         set score($j,$i) 0
  72.         }
  73.     }
  74.     }
  75. }
  76.  
  77. # スコアファイルライト
  78. proc write_score_file {} {
  79.     global score_file name date score
  80.     set f [open $score_file w]
  81.     foreach j {6 7 8} {
  82.     for {set i 1} {$i <= 10} {incr i} {
  83.         puts $f [format "%s\t%d\t%d" $name($j,$i) $date($j,$i) $score($j,$i)]
  84.     }
  85.     }
  86.     close $f
  87. }
  88.  
  89. #
  90. # トップテンウィンドウを開く
  91. #
  92. proc open_score_window {ranking} {
  93.     global name date score piece_num color_num play_flag
  94.     if [winfo exists .t1] {
  95.     destroy .t1
  96.     }
  97.     toplevel .t1
  98.     wm title .t1 "Top 10"
  99.     frame .t1.f0
  100.     frame .t1.f1
  101.     label .t1.f0.l0 -text "順位  名前" -anchor w
  102.     label .t1.f1.l0 -text " 記録   日付  " -anchor w
  103.     pack .t1.f0.l0 -fill x
  104.     pack .t1.f1.l0 -fill x
  105.     if {$play_flag == 0} {
  106.     set num $color_num
  107.     } else {
  108.     set num $piece_num
  109.     }
  110.     for {set i 1} {$i <= 10} {incr i} {
  111.     label .t1.f0.l$i -text [format "%4d %-20s" $i $name($num,$i)] -anchor w
  112.     label .t1.f1.l$i -text [format "%6d %8s" \
  113.                 $score($num,$i) \
  114.                 [clock format $date($num,$i) -format "%y/%m/%d"]]
  115.     pack  .t1.f0.l$i -fill x
  116.     pack  .t1.f1.l$i -fill x
  117.     }
  118.     if {$ranking > 0} {
  119.     .t1.f0.l$ranking configure -fg red
  120.     .t1.f1.l$ranking configure -fg red
  121.     }
  122.     pack .t1.f0 .t1.f1 -side left
  123. }
  124.  
  125. # ベストテンに入るか
  126. proc check_hi_score {now_score} {
  127.     global score piece_num
  128.     for {set i 1} {$i <= 10} {incr i} {
  129.     if {$score($piece_num,$i) < $now_score} {
  130.         # ベストテンに入ったよ
  131.         return $i
  132.     }
  133.     }
  134.     return 0
  135. }
  136.  
  137. # スコアの更新
  138. proc update_score {n d s o} {
  139.     global name date score piece_num
  140.     for {set i 9} {$i >= $o} {incr i -1} {
  141.     set j [expr $i + 1]
  142.     set name($piece_num,$j) $name($piece_num,$i)
  143.     set date($piece_num,$j) $date($piece_num,$i)
  144.     set score($piece_num,$j) $score($piece_num,$i)
  145.     }
  146.     set name($piece_num,$o) $n
  147.     set date($piece_num,$o) $d
  148.     set score($piece_num,$o) $s
  149. }
  150.  
  151. # トップテンの名前入力
  152. proc input_hi_score_name {ranking} {
  153.     global buff2
  154.     set buff2 ""
  155.     toplevel .t2
  156.     wm title .t2 "Input Your Name"
  157.     wm geometry .t2 "+[expr [winfo x .] + 120]+[expr [winfo y .] + 180]"
  158.     label .t2.l0 -text [format "おめでとう！ %d 位です" $ranking]
  159.     label .t2.l1 -text "名前を入力してね"
  160.     entry .t2.e0 -textvariable buff2
  161.     focus -force .t2.e0
  162.     grab set -global .t2
  163.     bind .t2.e0 <Return> {
  164.     # 入力チェックが必要か
  165.     if {$buff2 != ""} {
  166.         destroy .t2
  167.     }
  168.     }
  169.     pack .t2.l0 .t2.l1 .t2.e0
  170. }
  171.  
  172. # 初期化
  173. proc init_board {} {
  174.     global board piece board_l piece_l
  175.     for {set x 0} {$x < 6} {incr x} {
  176.     for {set y 0} {$y < 8} {incr y} {
  177.         set board($x,$y) 0
  178.         .c0 itemconfigure $piece($x,$y) -fill gray60
  179.     }
  180.     }
  181.     for {set x 0} {$x < 6} {incr x} {
  182.     set board_l($x) 0
  183.     .c0 itemconfigure $piece_l($x) -fill gray60
  184.     }
  185. }
  186.  
  187. # 駒を消せるか
  188. proc check_remove_yoko {x y} {
  189.     global board remove_piece
  190.     set c $board($x,$y)
  191.     set i 1
  192.     set xs $x
  193.     # 左
  194.     for {set x1 [expr $x - 1]} {$x1 >= 0} {incr x1 -1} {
  195.     if {$board($x1,$y) != $c} break
  196.     set xs $x1
  197.     incr i
  198.     }
  199.     # 右
  200.     set xe $x
  201.     for {set x1 [expr $x + 1]} {$x1 < 6} {incr x1} {
  202.     if {$board($x1,$y) != $c} break
  203.     set xe $x1
  204.     incr i
  205.     }
  206.     if {$i >= 3} {
  207.     # 消去できる
  208.     while {$xs <= $xe} {
  209.         set remove_piece [concat $remove_piece $xs $y]
  210.         incr xs
  211.     }
  212.     }
  213. }
  214.  
  215. proc check_remove_tate {x y} {
  216.     global board remove_piece
  217.     set c $board($x,$y)
  218.     set i 1
  219.     set ys $y
  220.     # 上
  221.     for {set y1 [expr $y - 1]} {$y1 >= 0} {incr y1 -1} {
  222.     if {$board($x,$y1) != $c} break
  223.     set ys $y1
  224.     incr i
  225.     }
  226.     # 下
  227.     set ye $y
  228.     for {set y1 [expr $y + 1]} {$y1 < 8} {incr y1} {
  229.     if {$board($x,$y1) != $c} break
  230.     set ye $y1
  231.     incr i
  232.     }
  233.     if {$i >= 3} {
  234.     # 消去できる
  235.     while {$ys <= $ye} {
  236.         set remove_piece [concat $remove_piece $x $ys]
  237.         incr ys
  238.     }
  239.     }
  240. }
  241.  
  242. # 左上 <-- (x,y) --> 右下
  243. proc check_remove_naname1 {x y} {
  244.     global board remove_piece
  245.     set c $board($x,$y)
  246.     set i 1
  247.     # 左上
  248.     set xs $x
  249.     set ys $y
  250.     set x1 [expr $x - 1]
  251.     set y1 [expr $y - 1]
  252.     while {$x1 >= 0 && $y1 >= 0} {
  253.     if {$board($x1,$y1) != $c} break
  254.     set xs $x1
  255.     set ys $y1
  256.     incr x1 -1
  257.     incr y1 -1
  258.     incr i
  259.     }
  260.     # 右下
  261.     set xe $x
  262.     set ye $y
  263.     set x1 [expr $x + 1]
  264.     set y1 [expr $y + 1]
  265.     while {$x1 < 6 && $y1 < 8} {
  266.     if {$board($x1,$y1) != $c} break
  267.     set xe $x1
  268.     set ye $y1
  269.     incr x1
  270.     incr y1
  271.     incr i
  272.     }
  273.     if {$i >= 3} {
  274.     # 消去できる
  275.     while {$xs <= $xe} {
  276.         set remove_piece [concat $remove_piece $xs $ys]
  277.         incr xs
  278.         incr ys
  279.     }
  280.     }
  281. }
  282.  
  283. # 左下 <-- (x,y) --> 右上
  284. proc check_remove_naname2 {x y} {
  285.     global board remove_piece
  286.     set c $board($x,$y)
  287.     set i 1
  288.     # 左下
  289.     set xs $x
  290.     set ys $y
  291.     set x1 [expr $x - 1]
  292.     set y1 [expr $y + 1]
  293.     while {$x1 >= 0 && $y1 < 8} {
  294.     if {$board($x1,$y1) != $c} break
  295.     set xs $x1
  296.     set ys $y1
  297.     incr x1 -1
  298.     incr y1
  299.     incr i
  300.     }
  301.     # 右上
  302.     set xe $x
  303.     set ye $y
  304.     set x1 [expr $x + 1]
  305.     set y1 [expr $y - 1]
  306.     while {$x1 < 6 && $y1 >= 0} {
  307.     if {$board($x1,$y1) != $c} break
  308.     set xe $x1
  309.     set ye $y1
  310.     incr x1
  311.     incr y1 -1
  312.     incr i
  313.     }
  314.     if {$i >= 3} {
  315.     # 消去できる
  316.     while {$xs <= $xe} {
  317.         set remove_piece [concat $remove_piece $xs $ys]
  318.         incr xs
  319.         incr ys -1
  320.     }
  321.     }
  322. }
  323.  
  324. # スコアの表示
  325. proc display_score {num count} {
  326.     global message1 now_score
  327.     # 1 -> 2 -> 4 -> 8 と連鎖するたびに得点が増える
  328.     set c [expr 1 << $count]
  329.     incr now_score [expr $c * $c * $num * $num]
  330.     set message1 [format "            Score %6d" $now_score]
  331. }
  332.  
  333. # 駒を消去する
  334. proc delete_piece {count} {
  335.     global board remove_piece piece now_score
  336.     set len [llength $remove_piece]
  337.     set i 0
  338.     set j 0
  339.     while {$i < $len} {
  340.     set x [lindex $remove_piece $i]
  341.     incr i
  342.     set y [lindex $remove_piece $i]
  343.     incr i
  344.     if {$board($x,$y) != 0} {
  345.         set board($x,$y) 0
  346.         incr j
  347.         # タグを付ける
  348.         .c0 itemconfigure $piece($x,$y) -tags remove
  349.     }
  350.     }
  351.     # アニメーションさせる
  352.     foreach c {white gray90 gray75 gray60} {
  353.     .c0 itemconfigure remove -fill $c
  354.     update
  355.     after 150
  356.     }
  357.     # タグを取り除く
  358.     .c0 dtag remove remove
  359.     # スコアの計算
  360.     display_score $j $count
  361. }
  362.  
  363. # 駒の交換 (x1,y1) <--- (x2,y2)
  364. proc change_piece {x1 y1 x2 y2} {
  365.     global board piece color down_piece
  366.     set c $board($x2,$y2)
  367.     set board($x1,$y1) $c
  368.     set board($x2,$y2) 0
  369.     .c0 itemconfigure $piece($x1,$y1) -fill $color($c)
  370.     .c0 itemconfigure $piece($x2,$y2) -fill gray60
  371.     set down_piece [concat $down_piece $x1 $y1]
  372. }
  373.  
  374. # 空いている位置に駒を移動させる
  375. proc move_piece_down {} {
  376.     global block board down_piece
  377.     set down_piece ""
  378.     for {set x 0} {$x < 6} {incr x 1} {
  379.     # 空いている位置を探す
  380.     set ys 7
  381.     while {$ys >= 0} {
  382.         if {$board($x,$ys) == 0} break
  383.         incr ys -1
  384.     }
  385.     while {$ys > 0} {
  386.         # 駒を探す
  387.         set ye [expr $ys - 1]
  388.         while {$ye >= 0} {
  389.         if {$board($x,$ye) != 0} break
  390.         incr ye -1
  391.         }
  392.         # 駒が見つからなければループから脱出
  393.         if {$ye < 0} break
  394.         # 移動
  395.         change_piece $x $ys $x $ye
  396.         incr ys -1
  397.     }
  398.     }
  399. }
  400.  
  401. # 駒を消すことができるか
  402. proc check_remove_piece {} {
  403.     global board block_x remove_piece down_piece
  404.     set remove_piece ""
  405.     # 押し上げた列をチェック
  406.     for {set x 0} {$x < 2} {incr x} {
  407.     set x1 [expr $block_x + $x]
  408.         for {set y 7} {$y >= 0} {incr y -1} {
  409.         if {$board($x1,$y) == 0} break
  410.         check_remove_yoko    $x1 $y
  411.         check_remove_tate    $x1 $y
  412.         check_remove_naname1 $x1 $y
  413.         check_remove_naname2 $x1 $y
  414.     }
  415.     }
  416.     set count 0
  417.     while {$remove_piece != ""} {
  418.     update
  419.     after 250
  420.     # 消去できる
  421.     delete_piece $count
  422.     # ブロックを落とす
  423.     move_piece_down
  424.     # 落としたブロックのチェック
  425.     set remove_piece ""
  426.     set len [llength $down_piece]
  427.     set i 0
  428.     while {$i < $len} {
  429.         set x [lindex $down_piece $i]
  430.         incr i
  431.         set y [lindex $down_piece $i]
  432.         incr i
  433.         check_remove_yoko    $x $y
  434.         check_remove_tate    $x $y
  435.         check_remove_naname1 $x $y
  436.         check_remove_naname2 $x $y
  437.     }
  438.     incr count
  439.     }
  440. }
  441.  
  442. # ブロックの移動
  443. proc move_block_up {} {
  444.     global block block_x play_flag board piece color
  445.     if {$play_flag != 1} return
  446.     set x1 $block_x
  447.     set x2 [expr $x1 + 1]
  448.     # 上に空きがあるか
  449.     if {$board($x1,0) != 0 || $board($x2,0) != 0} return
  450.     # 二重入力禁止
  451.     set play_flag 2
  452.     # ブロックを挿入する
  453.     for {set y 1} {$y <= 7} {incr y} {
  454.     set y1 [expr $y - 1]
  455.     set board($x1,$y1) $board($x1,$y)
  456.     set board($x2,$y1) $board($x2,$y)
  457.     .c0 itemconfigure $piece($x1,$y1) -fill $color($board($x1,$y1))
  458.     .c0 itemconfigure $piece($x2,$y1) -fill $color($board($x2,$y1))
  459.     }
  460.     set board($x1,7) $block(0)
  461.     set board($x2,7) $block(1)
  462.     .c0 itemconfigure $piece($x1,7) -fill $color($board($x1,7))
  463.     .c0 itemconfigure $piece($x2,7) -fill $color($board($x2,7))
  464.     # ブロックを消去
  465.     delete_block
  466.     check_remove_piece
  467.     if [check_game_over] {
  468.     game_over
  469.     } else {
  470.     set_block_start
  471.     decide_next_block
  472.     # 入力禁止解除
  473.     set play_flag 1
  474.     }
  475. }
  476.  
  477. proc move_block_right {} {
  478.     global block block_x play_flag
  479.     if {$play_flag != 1} return
  480.     # 右端のチェック
  481.     if {$block_x == 4} return
  482.     delete_block
  483.     # 移動
  484.     incr block_x
  485.     display_block
  486.     update
  487. }
  488.  
  489. proc move_block_left {} {
  490.     global block_x play_flag
  491.     if {$play_flag != 1} return
  492.     # 左端のチェック
  493.     if {$block_x == 0} return
  494.     delete_block
  495.     # 移動
  496.     incr block_x -1
  497.     display_block
  498.     update
  499. }
  500.  
  501. # ブロックの回転
  502. proc rotation_block {} {
  503.     global block play_flag
  504.     if {$play_flag != 1} return
  505.     set temp $block(0)
  506.     set block(0) $block(1)
  507.     set block(1) $temp
  508.     display_block
  509.     update
  510. }
  511.  
  512. # ブロックを消去する
  513. proc delete_block {} {
  514.     global block piece_l block_x
  515.     set x $block_x
  516.     for {set i 0} {$i < 2} {incr i} {
  517.     .c0 itemconfigure $piece_l($x) -fill gray60
  518.     incr x
  519.     }
  520. }
  521.  
  522. # ブロックを表示する
  523. proc display_block {} {
  524.     global block block_x block_l piece_l color
  525.     set x $block_x
  526.     for {set i 0} {$i < 2} {incr i} {
  527.     .c0 itemconfigure $piece_l($x) -fill $color($block($i)) 
  528.     incr x
  529.     }
  530. }
  531.  
  532. # 次のブロックを決める
  533. proc decide_next_block {} {
  534.     global next_block next_piece color piece_num
  535.     for {set i 0} {$i < 2} {incr i} {
  536.     set c [expr int( rand() * $piece_num ) + 1]
  537.     set next_block($i) $c
  538.     .c0 itemconfigure $next_piece($i) -fill $color($c)
  539.     }
  540. }
  541.  
  542. # ブロックを開始位置にセット
  543. proc set_block_start {} {
  544.     global next_block block block_x
  545.     set block_x 4
  546.     for {set i 0} {$i < 2} {incr i} {
  547.     set block($i) $next_block($i)
  548.     }
  549.     display_block
  550. }
  551.  
  552. # 手詰まりをチェック
  553. proc check_game_over {} {
  554.     global board
  555.     for {set x1 0} {$x1 < 5} {incr x1} {
  556.     set x2 [expr $x1 + 1]
  557.     if {$board($x1,0) == 0 && $board($x2,0) == 0} {
  558.         return 0
  559.     }
  560.     }
  561.     return 1
  562. }
  563.  
  564. # ゲーム終了
  565. proc game_over {} {
  566.     global now_score buff2 play_flag
  567.     set ranking [check_hi_score $now_score]
  568.     if {$ranking > 0} {
  569.     input_hi_score_name $ranking 
  570.     tkwait window .t2
  571.     update_score $buff2 [clock seconds] $now_score $ranking
  572.     write_score_file
  573.     open_score_window $ranking
  574.     } else {
  575.     tk_messageBox -type ok -message "得点は $now_score 点でした"
  576.     }
  577.     set play_flag 0
  578. }
  579.  
  580.  
  581. # ゲームの開始
  582. proc start_game {} {
  583.     global now_score move_count play_flag
  584.     global piece_num color_num
  585.     if {$play_flag != 0} {
  586.     set ans [tk_messageBox -type yesno -icon question \
  587.                    -message "ゲームを中断しますか？"]
  588.         if {$ans == "no"} return
  589.     set play_flag 0
  590.     }
  591.     set now_score 0
  592.     set move_count 0
  593.     set play_flag 1
  594.     set piece_num $color_num
  595.     init_board
  596.     decide_next_block
  597.     set_block_start
  598.     decide_next_block
  599.     display_block
  600.     display_score 0 0
  601.     update
  602. }
  603.  
  604. # バインド  カーソルキーにも対応
  605. bind . 5       "rotation_block"
  606. bind . <Down>  "rotation_block"
  607. bind . <Up>    "move_block_up"
  608. bind . <space> "move_block_up"
  609. bind . 8       "move_block_up"
  610. bind . 4       "move_block_left"
  611. bind . <Left>  "move_block_left"
  612. bind . 6       "move_block_right"
  613. bind . <Right> "move_block_right"
  614.  
  615. bind . s "start_game"
  616.  
  617.  
  618. # ********** メニューの設定 **********
  619. menu .m -type menubar
  620. . configure -menu .m
  621. .m add cascade -label "Games"    -under 0 -menu .m.m1
  622. .m add cascade -label "Color"    -under 0 -menu .m.m2
  623. .m add command -label "Help"     -under 0 -command "help"
  624. menu .m.m1 -tearoff no
  625. .m.m1 add command -label "Start"   -under 0 -command "start_game"
  626. .m.m1 add command -label "HiScore" -under 0 -command "open_score_window 0"
  627. .m.m1 add separator
  628. .m.m1 add command -label "Exit" -under 0 -command "exit"
  629. menu .m.m2 -tearoff no
  630. .m.m2 add radiobutton -label "6 Colors" -variable color_num -value 6
  631. .m.m2 add radiobutton -label "7 Colors" -variable color_num -value 7
  632. .m.m2 add radiobutton -label "8 Colors" -variable color_num -value 8
  633.  
  634. # ********** 画面の生成 **********
  635. option add *font "{ＭＳ ゴシック} 12"
  636. canvas .c0 -width 320 -height 320
  637. .c0 create rectangle 0 0 320 320 -fill darkgreen
  638.  
  639. # board 用
  640. for {set x 0} {$x < 6} {incr x} {
  641.     set x1 [expr 32 * $x + 32]
  642.     set x2 [expr $x1 + 32]
  643.     for {set y 0} {$y < 8} {incr y} {
  644.     set y1 [expr 32 * $y]
  645.     set y2 [expr $y1 + 32]
  646.     set piece($x,$y) [.c0 create rectangle $x1 $y1 $x2 $y2 -fill gray60 -outline gray60]
  647.     }
  648. }
  649.  
  650. # board_l 用
  651. for {set x 0} {$x < 6} {incr x} {
  652.     set x1 [expr 32 * $x + 32]
  653.     set x2 [expr $x1 + 32]
  654.     set piece_l($x) [.c0 create rectangle $x1 264 $x2 296 -fill gray60 -outline gray60]
  655. }
  656.  
  657.  
  658. # next block 用
  659. for {set x 0} {$x < 2} {incr x} {
  660.     set x1 [expr 32 * $x + 232]
  661.     set x2 [expr $x1 + 32]
  662.     set next_piece($x) [.c0 create rectangle $x1 264 $x2 296 -fill gray60 -outline gray60]
  663. }
  664. .c0 create text 264 250 -text "ＮＥＸＴ" -fill white
  665.  
  666.  
  667. # 色の設定
  668. set x 0
  669. foreach c {gray60 red blue yellow green cyan purple orange seagreen} {
  670.     set color($x) $c
  671.     incr x
  672. }
  673.  
  674. # スコア表示用
  675. label .l0 -textvariable message1 -bg darkgreen -fg white -anchor w
  676.  
  677. pack .l0 -fill x
  678. pack .c0
  679.  
  680. # 窓の題名
  681. wm title . "Block Up"
  682. wm resizable . 0 0
  683.  
  684. # 初期化
  685. set play_flag 0
  686. set color_num 6
  687. set path_name [file dirname $argv0]
  688. set score_file "$path_name/BLOCKUP.SCO"
  689.  
  690. # スコアファイルのリード
  691. read_score_file
  692. focus -force .
  693.  
  694. # end of file
  695.  
  696.